Gold Medal Software 1/Gold Medal Software Volume 1 (Gold Medal) (1994).iso/prog/tpwprog3.arj/UGRAPHIC.PAS

Pascal/Delphi Source File | 1992-07-02 | 26.9 KB | 1,031 lines

{******************************************************************}
{                                                                  }
{     Mancala                                                      }
{     Turbo Pascal for Windows                                     }
{     Copyright (c) 1991 by Swan Software. All rights reserved.    }
{                                                                  }
{******************************************************************}

{ ugraphic.pas -- Graphics support module for Mancala }

unit UGraphics;

interface

uses WinTypes, WinProcs, Strings, UGlobals, UEval, UMove, Idents;


procedure DisplayMessage(DC: HDC; StrIndex: Integer);
procedure PutPebble(DC: HDC; P: TPoint);
procedure MovePebble(DC: HDC; Fp, Tp: TPoint);
procedure EmptyTheCup(DC: HDC; CupNum: CupIndex);
procedure DisplayNumber(DC: HDC; CupNum: CupIndex; N: Integer);
procedure DrawPebbles(DC: HDC; CupNum: CupIndex; NumPebbles: Integer);
procedure PickUpPebbles(DC: HDC; CupNum: CupIndex; Side: Integer;
  var Gameboard: Board);
procedure DrawGameboard(DC: HDC; var Gameboard: Board);
procedure MakeGraphMove(DC: HDC; Position: BoardRec; Side: Integer;
  Move: OneMove);
procedure InitUGraphics;


implementation

const

{- FlashBuf stores the bits for an image used to flash cups on and off
   during the computer's moves and for captures as a device to alert your
   attention to where the action will occur next. }

  FlashBuf: array[0 .. 113] of Byte = (
    $80, $00, $00, $00, $00, $01,
    $E0, $00, $00, $00, $00, $07,
    $F0, $00, $00, $00, $00, $0F,
    $7C, $00, $00, $00, $00, $3E,
    $7F, $80, $00, $00, $01, $FE,
    $3F, $F0, $00, $00, $0F, $FC,
    $3F, $FF, $80, $01, $FF, $FC,
    $1F, $FF, $FF, $FF, $FF, $F8,
    $0F, $FF, $FF, $FF, $FF, $F0,
    $0F, $FF, $FF, $FF, $FF, $F0,
    $07, $FF, $FF, $FF, $FF, $E0,
    $03, $FF, $FF, $FF, $FF, $C0,
    $01, $FF, $FF, $FF, $FF, $80,
    $00, $FF, $FF, $FF, $FF, $00,
    $00, $3F, $FF, $FF, $FC, $00,
    $00, $1F, $FF, $FF, $F8, $00,
    $00, $07, $FF, $FF, $E0, $00,
    $00, $01, $FF, $FF, $80, $00,
    $00, $00, $1F, $F8, $00, $00
  );


var


{- The MessageRect rectangle outlines the area where various messages
appear during the game. }

  MessageRect: TRect;


{- The Seed value starts a new random number sequence for the Rand
function, which is used to place pebbles at random, but repeatable, postions
inside cups. }

  Seed: Integer;


{- Delay for MSecs milliseconds (approximately) }

procedure Delay(MSecs: LongInt);
var
  Mark: LongInt;
begin
  Mark := GetTickCount + MSecs;
  repeat { Wait } until GetTickCount >= Mark;
end;


{- Set Seed to CupNum * 2 and call Rand for repeatable random number
sequences for positioning pebbles inside cups. This is not a very good
random number generator. Don't use it for any other purpose. }

function Rand: Integer;
const
  A = 31415;
  C = 6923;
begin
  Seed := (A * Seed + C) mod MaxInt;
  Rand := Seed;
end;


{- Draw shadow outside bottom of cup anchored at p }

procedure Shadow(DC: HDC; P: TPoint);
var
  Brush: HBrush;                  { Brush for filling shadow }
  OldBrush: HBrush;               { For saving DC's current brush }
  CShadow: TColorRef;             { Color of shadow }
begin
  CShadow := RGB(0, 0, 0);
  Brush := CreateSolidBrush(CShadow);
  OldBrush := SelectObject(DC, Brush);
  with P do
    Ellipse(DC, X + 17, Y + 47, X + 52, Y + 57);
  SelectObject(DC, OldBrush);
  DeleteObject(Brush);
end;


{- Draw outer cup anchored at p }

procedure OuterCup(DC: HDC; P: TPoint);
var
  Brush: HBrush;                  { Brush for filling outer cup }
  OldBrush: HBrush;               { For saving DC's current brush }
begin
  Brush := CreateSolidBrush(COuterCup);
  OldBrush := SelectObject(DC, Brush);
  with P do
    Chord(DC, X, Y, X + 52, Y + 52, X, Y + 26, X + 52, Y + 26);
  SelectObject(DC, OldBrush);
  DeleteObject(Brush);
end;


{- Draw inner cup }

procedure InnerCup(DC: HDC; P: TPoint);
var
  Brush: HBrush;                  { Brush for filling inner cup }
  OldBrush: HBrush;               { For saving DC's current brush }
  CInnerCup: TColorRef;           { Color of inner cup }
begin
  CInnerCup := RGB(247, 232, 159);
  Brush := CreateSolidBrush(CInnerCup);
  OldBrush := SelectObject(DC, Brush);
  with P do
    Ellipse(DC, X, Y + 13, X + 52, Y + 39);
  SelectObject(DC, OldBrush);
  DeleteObject(Brush);
end;


{- Draw shadow inside bottom of cup }

procedure BottomCup(DC: HDC; P: TPoint);
var
  Brush: HBrush;                  { Brush for filling inner shadow }
  OldBrush: HBrush;               { For saving DC's current brush }
begin
  Brush := CreateSolidBrush(CInnerShadow);
  OldBrush := SelectObject(DC, Brush);
  with P do
    Ellipse(DC, X + 12, Y + 34, X + 40, Y + 40);
  SelectObject(DC, OldBrush);
  DeleteObject(Brush);
end;


{- Fill CupCoords array with anchor coordinates for each cup. }

procedure InitCupCoords;
var
  I: Integer;                     { For-loop and array index }
  Xc, Yc: Integer;                { Horizontal, vertical coordinate values }
begin
  Yc := YBase - 28;
  Xc := XBase + 60;
  for I := CompLastCup downto CompFirstCup do
  begin
    with CupCoords[I] do
    begin
      X := Xc;
      Y := Yc;
    end;
    Xc := Xc + 60;
  end;
  Yc := Yc + 55;
  Xc := XBase + 60;
  for I := HumanFirstCup to HumanLastCup do
  begin
    with CupCoords[I] do
    begin
      X := Xc;
      Y := Yc;
    end;
    Xc := Xc + 60
  end;
  with CupCoords[CompKalah] do
  begin
    X := XBase;
    Y := YBase;
  end;
  with CupCoords[HumanKalah] do
  begin
    X := XBase + 420;
    Y := YBase;
  end;
end;


{- Paint a rectangle filled with the specified brush }

procedure FillRect(DC: HDC; R: TRect; Brush: HBrush);
var
  OldBrush: HBrush;
begin
  OldBrush := SelectObject(DC, Brush);
  with R do
    Rectangle(DC, Left, Top, Right, Bottom);
  SelectObject(DC, OldBrush);
end;


{- Draw an unfilled rectangle R in the current pen color }

procedure FrameRect(DC: HDC; R: TRect);
begin
  FillRect(DC, R, GetStockObject(null_Brush));
end;


{- Paint a rounded rectangle filled with the specified brush }

procedure FillRoundRect(DC: HDC; R: TRect; W, H: Integer; Brush: HBrush);
var
  OldBrush: HBrush;
begin
  OldBrush := SelectObject(DC, Brush);
  with R do
    RoundRect(DC, Left, Top, Right, Bottom, W, H);
  SelectObject(DC, OldBrush);
end;


{- Draw an unfilled rounded rectangle R in the current pen color }

procedure FrameRoundRect(DC: HDC; R: TRect; W, H: Integer);
begin
  FillRoundRect(DC, R, W, H, GetStockObject(null_Brush));
end;


{- Erase rectangle to the specified color }

procedure EraseRect(DC: HDC; R: TRect; C: TColorRef);
var
  Brush, OldBrush: HBrush;
  OldPen: HPen;
begin
  Brush := CreateSolidBrush(COuterCup);
  OldBrush := SelectObject(DC, Brush);
  OldPen := SelectObject(DC, GetStockObject(null_Pen));
  with R do
    Rectangle(DC, Left, Top, Right, Bottom);
  SelectObject(DC, OldPen);
  SelectObject(DC, OldBrush);
  DeleteObject(Brush);
end;


{- Return new TPoint record P for a pebble to be placed at random
in cup CupNum }

procedure GetPebblePoint(CupNum: CupIndex; var P: TPoint);
var
  Dx, Dy: Integer;
begin
{- Calculate random offsets within the cup }
  Dx := 12 + (Abs(Rand) mod 23);  { 12 .. 34 }
  Dy := 17 + (Abs(Rand) mod 12);  { 17 .. 28 }
{- Assign the cup's anchor point to P }
  P := CupCoords[CupNum];
{- Offset the point to create the pebble position }
  with P do
  begin
    X := X + Dx;
    Y := Y + Dy;
  end;
end;


{- Display how many pebbles it takes to win, placing message in upper
right corner. }

procedure DisplayPebblesToWin(DC: HDC);
const
  maxLen = 30;                    { Maximum length of message string }
var
  C: array[0 .. maxLen - 4] of Char;
  N: String[3];
  S: String[maxLen];
begin
  if LoadString(HInstance, Pebbles_To_Win, C, maxLen) > 0 then
  begin
    Str(PebblesDiv2, N);
    S := N + ' ' + StrPas(C);
    TextOut(DC, XBase + 275, YBase - 85, @S[1], Length(S));
  end;
end;


{- Flash outside of cup during computer moves and all captures }

procedure BlinkCup(DC: HDC; CupNum: CupIndex);
var
  I: Integer;
  MemDC: HDC;
  OldBitmap: HBitmap;
begin
  MemDC := CreateCompatibleDC(DC);
  OldBitmap := SelectObject(MemDC, FlashBits);
  for I := 1 to 8 do
  begin
    Delay(100);
    with CupCoords[CupNum] do
      BitBlt(DC, X + 2, Y + 32, X + 50, Y + 51, MemDC, 0, 0, srcInvert);
  end;
  SelectObject(MemDC, OldBitmap);
  DeleteDC(MemDC);
  Delay(16);
end;


{- Draw animation between these two coordinates. This is a modified
8-quadrant line generator. The animation is simply a blot that moves
between the two points. }

procedure Animate(DC: HDC; StartX, StartY, EndX, EndY: Integer);

const

   speed = 24;     { Number of pixels between animation frames.
                     Higher values = faster speeds. Might make
                     this variable someday to account for
                     different processor speeds. }
var

   Dx, Dy: Integer;               { Delta (i.e. change in) values }
   PebPt: TPoint;                 { Pebble point location }
   Count: Integer;                { Controls when plotting occurs }
   OldMode: Integer;              { Saves current DC's display mode }


   procedure SetPt(var P: TPoint; X, Y: Integer);
   begin
     P.X := X;
     P.Y := Y;
   end;


{- Draw animation frame at this location after erasing frame at
previous location. Actual plotting only occurs in multiples of
the speed value. }

   procedure Plot(X, Y: Integer);
   begin
     if (Count mod Speed) = 0 then
     begin
       PutPebble(DC, PebPt);      { Erase old pebble }
       SetPt(PebPt, X, Y);        { Move to new location }
       PutPebble(DC, PebPt);      { Draw pebble }
     end;
     Inc(count);
   end;

   procedure Octant1;
   var
     CntDwn, Err: Integer;
   begin
     CntDwn := Dx + 1;
     Err := -Dx div 2;
     repeat
       repeat
         Plot(StartX, StartY);
         CntDwn := CntDwn - 1;
         if CntDwn < 0 then Exit;
         StartX := StartX + 1;
         Err := Err - Dy
       until Err >= 0;
       StartY := StartY - 1;
       Err := Err - Dx;
     until false;
   end;

   procedure Octant2;
   var
     CntDwn, Err: Integer;
   begin
     CntDwn := -Dy + 1;
     Err := Dy div 2;
     repeat
       repeat
         Plot(StartX, StartY);
         CntDwn := CntDwn - 1;
         if CntDwn < 0 then Exit;
         StartY := StartY - 1;
         Err := Err + Dx;
       until Err >= 0;
       StartX := StartX + 1;
       Err := Err + Dy;
     until false;
   end;

   procedure Octant3;
   var
     CntDwn, Err: Integer;
   begin
     CntDwn := -Dy + 1;
     Err := Dy div 2;
     repeat
       repeat
         Plot(StartX, StartY);
         CntDwn := CntDwn - 1;
         if CntDwn < 0 then Exit;
         StartY := StartY - 1;
         Err := Err - Dx;
       until Err >= 0;
       StartX := StartX - 1;
       Err := Err + Dy;
     until false;
   end;

   procedure Octant4;
   var
     CntDwn, Err: Integer;
   begin
     CntDwn := -Dx + 1;
     Err := Dx div 2;
     repeat
       repeat
         Plot(StartX, StartY);
         CntDwn := CntDwn - 1;
         if CntDwn < 0 then Exit;
         StartX := StartX - 1;
         Err := Err - Dy;
       until Err >= 0;
       StartY := StartY - 1;
       Err := Err + Dx;
     until false;
   end;

   procedure Octant5;
   var
     CntDwn, Err: Integer;
   begin
     CntDwn := -Dx + 1;
     Err := Dx div 2;
     repeat
       repeat
         Plot(StartX, StartY);
         CntDwn := CntDwn - 1;
         if CntDwn < 0 then Exit;
         StartX := StartX - 1;
         Err := Err + Dy;
       until Err >= 0;
       StartY := StartY + 1;
       Err := Err + Dx;
     until false;
   end;

   procedure Octant6;
   var
     CntDwn, Err: Integer;
   begin
     CntDwn := Dy + 1;
     Err := -Dy div 2;
     repeat
       repeat
         Plot(StartX, StartY);
         CntDwn := CntDwn - 1;
         if CntDwn < 0 then Exit;
         StartY := StartY + 1;
         Err := Err - Dx;
       until Err >= 0;
       StartX := StartX - 1;
       Err := Err - Dy;
     until false;
   end;

   procedure Octant7;
   var
     CntDwn, Err: Integer;
   begin
     CntDwn := Dy + 1;
     Err := -Dy div 2;
     repeat
       repeat
         Plot(StartX, StartY);
         CntDwn := CntDwn - 1;
         if CntDwn < 0 then Exit;
         StartY := StartY + 1;
         Err := Err + Dx;
       until Err >= 0;
       StartX := StartX + 1;
       Err := Err - Dy;
     until false;
   end;

   procedure Octant8;
   var
     CntDwn, Err: Integer;
   begin
     CntDwn := Dx + 1;
     Err := -Dx div 2;
     repeat
       repeat
         Plot(StartX, StartY);
         CntDwn := CntDwn - 1;
         if CntDwn < 0 then Exit;
         StartX := StartX + 1;
         Err := Err + Dy;
       until Err >= 0;
       StartY := StartY + 1;
       Err := Err - Dx;
     until false;
   end;

begin

   Delay(200);

   Count := 1;          { Controls when plotting occurs }

   OldMode := SetROP2(DC, r2_NotXorPen);    { Use XOR drawing mode }


{- Initialize first frame so it can be erased by Plot. This
   is the position of the pebble in its group. }

   SetPt(PebPt, StartX, StartY);

   Dx := EndX - StartX;
   Dy := EndY - StartY;

   if Dx > 0 then
   begin      { Right half }
     if Dy < 0 then
     begin    { Top quadrant }
       if -Dy > Dx then Octant2 else Octant1;
     end else
     begin    { Bottom quadrant }
       if Dy > Dx then Octant7 else Octant8;
     end;
   end else
   begin      { Left half }
     if Dy < 0 then
     begin    { Top quadrant }
       if Dy > Dx then Octant4 else Octant3;
     end else
     begin    { Bottom quadrant }
       if Dy > -Dx then Octant6 else Octant5;
     end;
   end;

   PutPebble(DC, PebPt);     { Remove final plot }

   SetROP2(DC, OldMode);     { Restore DC's drawing mode }

end;


{- Display message in global MessageRect "window" reading the string
with resource id = MessageID, indexed by StrIndex parameter. If
StrIndex = 0, the message window is cleared. Save StrIndex in global
CurrentMessage variable, ensuring that the correct message will always
be redisplayed during update (paint) events. }

procedure DisplayMessage(DC: HDC; StrIndex: Integer);
const
  maxlen = 80;
var
  Message: array[0 .. maxLen] of Char;      { Holds string resource }
  MessageLen: Integer;                      { Length of message }
  Extent: LongInt;                          { Message height and width in pixels }
begin
  CurrentMessage := StrIndex;
  if LoadString(HInstance, CurrentMessage, Message, maxLen) > 0 then
  with MessageRect do
  begin
    MessageLen := StrLen(Message);
    Extent := GetTextExtent(DC, Message, MessageLen);
    FillRect(DC, MessageRect, GetStockObject(white_Brush));
    TextOut(DC,
      Left + (((Right - Left) - LOWORD(Extent)) div 2),
      Top + (((Bottom - Top) - HIWORD(Extent)) div 2),
      Message, StrLen(Message));
  end;
end;


{- Draw one pebble at P.X, P.Y }

procedure PutPebble(DC: HDC; P: TPoint);
var
  OldBrush: HBrush;
begin
  OldBrush := SelectObject(DC, GetStockObject(gray_Brush));
  with P do
    Ellipse(DC, X, Y, X + 7, Y + 7);
  SelectObject(DC, OldBrush);
end;


{- Move a pebble from Fp (from point) to Tp (to point) }

procedure MovePebble(DC: HDC; Fp, Tp: TPoint);
begin
  Animate(DC, Fp.X, Fp.Y, Tp.X, Tp.Y);
  PutPebble(DC, Tp);
end;


{- Erase inside of cup, removing any pebbles inside }

procedure EmptyTheCup(DC: HDC; CupNum: CupIndex);
begin
  InnerCup(DC, CupCoords[CupNum]);
  BottomCup(DC, CupCoords[CupNum]);
end;


{- Display N on face of this cup, representing the number
of pebbles in the cup. }

procedure DisplayNumber(DC: HDC; CupNum: CupIndex; N: Integer);
var
  S: String[3];
  R: TRect;
  OldBkMode: Integer;
  OldTextColor: TColorRef;
begin
  Str(N, S);
  with CupCoords[CupNum] do
  begin
    SetRect(R, X + 18, Y + 40, X + 34, Y + 52);
    EraseRect(DC, R, COuterCup);
    OldBkMode := SetBkMode(DC, Transparent);
    OldTextColor := SetTextColor(DC, RGB(255, 255, 255));
    R.Top := R.Top - 2;
    R.Bottom := R.Bottom + 4;
    DrawText(DC, @S[1], Length(S), R, dt_Center);
    SetTextColor(DC, OldTextColor);
    SetBkMode(DC, OldBkMode);
  end;
end;


{- Draw NumPebbles pebbles inside cup cupnum.  Erases cup before
drawing to make certain it's empty. Important to pass correct number
of pebbles in cup to this procedure, which does not refer to global
Gameboard. This makes it easier to write the graphics MakeMove routine,
which can display a number on the cup temporarily even if that does not
match the number of pebbles actually in the cup. }

procedure DrawPebbles(DC: HDC; CupNum: CupIndex; NumPebbles: Integer);
var
  PebblePoint: TPoint;
  I: Integer;
begin
  EmptyTheCup(DC, CupNum);        { Empty cup of any pebbles }
  Seed := CupNum;                 { Start random sequence for this cup }
  for I := 1 to NumPebbles do
  begin
    GetPebblePoint(CupNum, PebblePoint);
    PutPebble(DC, PebblePoint);
  end;
  DisplayNumber(DC, CupNum, NumPebbles);
end;


{- Move any pebbles out of cup, displaying them above board for
computer's side or below for human's cups. Erases face of cup, removing
any number there. Call this procedure for mouse clicks inside cup or for
computer's move as the first part of the animation sequence. Set Side to
human or computer and be sure that CupNum is appropriate for this side. }

procedure PickUpPebbles(DC: HDC; CupNum: CupIndex; Side: Integer;
  var Gameboard: Board);
var
  PebblePoint: TPoint;
  I, NumPebbles, Offset: Integer;
  OldMode: Integer;
begin
  NumPebbles := Gameboard[CupNum];
  if NumPebbles = 0 then Exit;
  if Side = human then
    Offset := 75
  else
    Offset := -50;
  EmptyTheCup(DC,CupNum);
  OldMode := SetROP2(DC, r2_NotXorPen);
  Seed := CupNum;
  for I := 1 to NumPebbles do
  begin
    GetPebblePoint(CupNum, PebblePoint);
    with PebblePoint do
      Y := Y + Offset;
    PutPebble(DC, PebblePoint);
  end;
  SetROP2(DC, OldMode);
end;


{- Draw gameboard and message window using global XBase, YBase. }

procedure DrawGameboard(DC: HDC; var Gameboard: Board);
var
  I, J, H, V: Integer;
  R1, R2: TRect;
  P: TPoint;
  Pen: HPen;            { Pen handle for outlines }
  OldPen: HPen;         { For saving DC's current pen }
  S: String[1];         { For cup labels }
begin

  Pen := CreatePen(ps_Solid, 1, CPen);
  OldPen := SelectObject(DC, Pen);


{- Initialize R1 to main board location }

  SetRect(R1, XBase + 2, YBase, XBase + 464, YBase + 100);


{- Draw the message center "window," which is not a real window, just a
box in which messages appear. The window appears with a shadow
10 pixels below and to the right. The global messageRect variable is
used by the DisplayMessage procedure. }

  MessageRect := R1;
  with R1 do
  begin
    OffsetRect(MessageRect, 0, (Bottom - Top) + 20);
    InflateRect(MessageRect, -((Right - Left) div 4), -((Bottom - Top) div 4));
  end;
  R2 := MessageRect;
  OffsetRect(R2, 10, 10);
  FillRect(DC, R2, GetStockObject(dkGray_Brush));
  FrameRect(DC, MessageRect);
  InflateRect(MessageRect, -1, -1);
  FillRect(DC, MessageRect, GetStockObject(white_Brush));


{- Draw the boards on which the cups rest }

  R2 := R1;
  OffsetRect(R2, 10, 10);
  FrameRoundRect(DC, R2, 20, 20);
  InflateRect(R2, -1, -1);
  FillRoundRect(DC, R2, 20, 20, GetStockObject(dkGray_Brush));
  FrameRoundRect(DC, R1, 20, 20);
  InflateRect(R1, -1, -1);
  FillRoundRect(DC, R1, 20, 20, GetStockObject(ltGray_Brush));


{- Draw the cups }

  for I := 0 to Maxcupindex do
  begin
    P := Cupcoords[I];
    Shadow(DC, P);
    OuterCup(DC, P);
    DrawPebbles(DC, I, Gameboard[I]);
  end;


{- Label cups with their numbers }

  for I := HumanFirstCup to HumanLastCup do
  begin
    Str(I, S);
    with Cupcoords[I] do
      TextOut(DC, X + 22, Y + 90, @S[1], 1);
  end;


{- Display the global CurrentMessage in the window. This takes care
of redisplaying messages during repaint events (which also call
DrawGameboard). }

  DisplayMessage(DC, CurrentMessage);


{- Display how many pebbles it takes to win }

  DisplayPebblesToWin(DC);


{- Clean up }

  SelectObject(DC, OldPen);
  DeleteObject(Pen);

end;


{- Make visual move. Program also must call MakeMove to make the same
move internally. MakeGraphMove is purely visual. }

procedure MakeGraphMove(DC: HDC; Position: BoardRec; Side: Integer;
  Move: OneMove);
var
  Cup: CupIndex;
  Pebbles: Integer;
  PlayerKalah: CupIndex;
  OpponentKalah: CupIndex;
  CaptureCup: CupIndex;
  FirstCup: CupIndex;
  LastCup: CupIndex;
  CupWasEmpty: Boolean;
  CapturedPebbles: Integer;
  OtherSide: Integer;

{- The pebbles are above or below the cup being moved. Take one pebble
and move it to cup number ToCup. NumPebbles equals the total number of
pebbles above or below FromCup. Sie indicates who FromCup belongs to.
By the time ZoomPebble is called, the move has been made on Position.Gameboard. }

  procedure ZoomPebble(FromCup, ToCup, NumPebbles, Side: Integer);
  var
    Fp, Tp: TPoint;               { From point, to point }
    Offset: Integer;              { Vertical offset to pebbles }
    I: Integer;
  begin
    if Side = human then
      Offset := 75                { Pebbles are below cup }
    else
      Offset := -50;              { Pebbles are above cup }
    Seed := FromCup;
    for I := 1 to NumPebbles do
      GetPebblePoint(FromCup, Fp);
    Fp.Y := Fp.Y + Offset;
    Seed := ToCup;
    for I := 1 to Position.Gameboard[ToCup] do
      GetPebblePoint(ToCup, Tp);
    MovePebble(DC, Fp, Tp);
  end;


{- Initialize for graphics move }

  procedure InitGmove;
  begin
    if Side = computer then
      BlinkCup(DC, Move);
    PickUpPebbles(DC, Move, Side, Position.Gameboard);
    DisplayNumber(DC, Move, 0);
    if Side = computer then
    begin { Set up for computer }
      OtherSide := human;
      PlayerKalah := CompKalah;
      OpponentKalah := HumanKalah;
      FirstCup := CompFirstCup;
      LastCup := CompLastCup;
    end else
    begin { Set up for human }
      OtherSide := computer;
      PlayerKalah := HumanKalah;
      OpponentKalah := CompKalah;
      FirstCup := HumanFirstCup;
      LastCup := HumanLastCup;
    end;
  end;


{- Make the move, distributing pebbles counter-clockwise }

  procedure MakeGMove;
  begin
    with Position do
    begin
      Cup := Move;
      Pebbles := Gameboard[Move];
      Gameboard[Move] := 0;
      while Pebbles > 0 do
      begin
        if Cup = MaxCupIndex then
          Cup := 0
        else
          Cup := Cup + 1;
        if Cup <> OpponentKalah then  { Skip opponent's kalah }
        begin
          CupWasEmpty := Gameboard[Cup] = 0;
          Gameboard[Cup] := Gameboard[Cup] + 1;
          ZoomPebble(Move, Cup, Pebbles, Side);
          Pebbles := Pebbles - 1;
          DisplayNumber(DC, Cup, Gameboard[Cup])
        end;
      end;
      GoAgain := (Cup = PlayerKalah)
    end;
  end;


{- Check for captures when player's last stone drops into one of the
player's own empty cups and an opposite cup contains pebbbles. }

  procedure DoCapture;
  begin
    with Position do
    begin
      if not GoAgain then
      if CupWasEmpty then
      if FirstCup <= Cup then
      if Cup <= LastCup then
      begin  { Capture }
        CaptureCup := maxCups - Cup;
        CapturedPebbles := Gameboard[CaptureCup];
        if CapturedPebbles > 0 then
        begin
          DisplayMessage(DC, Capture);
          BlinkCup(DC, CaptureCup);
          PickUpPebbles(DC, CaptureCup, OtherSide, Gameboard);
          DisplayNumber(DC, CaptureCup, 0);
          Gameboard[CaptureCup] := 0;
          while CapturedPebbles > 0 do
          begin
            Gameboard[PlayerKalah] :=
              Gameboard[PlayerKalah] + 1;
            ZoomPebble(CaptureCup, PlayerKalah,
              CapturedPebbles, OtherSide);
            DisplayNumber(DC, PlayerKalah,
              Gameboard[PlayerKalah]);
            CapturedPebbles := CapturedPebbles - 1;
          end;
          BlinkCup(DC, Cup);
          PickUpPebbles(DC, Cup, Side, Gameboard);
          DisplayNumber(DC, Cup, 0);
          Gameboard[Cup] := 0;
          Gameboard[PlayerKalah] :=
            Gameboard[PlayerKalah] + 1;
          ZoomPebble(Cup, PlayerKalah, 1, Side);
          DisplayNumber(DC, PlayerKalah,
            Gameboard[PlayerKalah]);
        end;
      end;
    end;
  end;


{- Move all stones from FirstCup to LastCup into this kalah. This action
occurs only when the opposite side's cups are all empty. }

  procedure moveallpebbles(var Gameboard: Board; TheSide: Integer;
    FirstCup, LastCup, Kalah: CupIndex);
  var
    I, Pebbles: Integer;
  begin
    with Position do
    begin
      Pebbles := 0;
      for I := FirstCup to LastCup do
      if Gameboard[I] > 0 then
      begin
        BlinkCup(DC, I);
        PickUpPebbles(DC, I, TheSide, Gameboard);
        DisplayNumber(DC, I, 0);
        Pebbles := Gameboard[I];
        Gameboard[I] := 0;
        while Pebbles > 0 do
        begin
          Gameboard[Kalah] := Gameboard[Kalah] + 1;
          ZoomPebble(I, Kalah, Pebbles, TheSide);
          DisplayNumber(DC, Kalah, Gameboard[Kalah]);
          Pebbles := Pebbles - 1
        end;
      end;
    end;
  end;


begin
  InitGMove;     { Initialize various things }
  MakeGMove;     { Make first part of move }
  DoCapture;     { Check for and make any captures }

{- Check for special condition where either side's cups are
all empty. In this case, unless the side that has gone out
has won, the opposite side moves all pebbles into that side's
kalah and wins. }

  with Position do
  begin
    if CupsEmpty(Gameboard, CompFirstCup, CompLastCup) then
    begin
      DisplayMessage(DC, Im_out);
      if Gameboard[CompKalah] < PebblesDiv2 then
        MoveAllPebbles(Gameboard, human, HumanFirstCup,
          HumanLastCup, HumanKalah)
    end else
    if CupsEmpty(Gameboard, HumanFirstCup, HumanLastCup) then
    begin
      DisplayMessage(DC, Youre_out);
      if Gameboard[HumanKalah] < PebblesDiv2 then
        MoveAllPebbles(Gameboard, computer, CompFirstCup,
          CompLastCup, CompKalah)
    end;
  end;
end;


{- Initialize UGraphics unit }

procedure InitUGraphics;
begin
  InitCupCoords;                  { Initialize cup coordinates }
  FlashBits := CreateBitmap(48, 19, 1, 1, @FlashBuf);
end;


end.


{ ----------------------------------------------------------------
  Copyright (c) 1991 by Swan Software. All rights reserved.
  Revision 1.00    Date: 8/21/1991
  ---------------------------------------------------------------- }